home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / axgrid / modtltip.bas < prev    next >
Encoding:
BASIC Source File  |  1998-09-11  |  12.8 KB  |  274 lines
  1. Attribute VB_Name = "modToolTip"
  2. '*****************************************************************
  3. '
  4. '   POPUPCOMMAND CONTROL
  5. '
  6. '   This code and control is absolutely freeware!
  7. '
  8. '   You have a royalty-free right to use, modify, reproduce and distribute
  9. '   the source code and control (and/or any modified version) in any way
  10. '   you find useful, provided that you agree that the authors have no warranty,
  11. '   obligations or liability for any code distributed in this project group.
  12. '
  13. ' Copyright ⌐ 1998 by Geoff Glaze
  14. '
  15. '   (Some parts borrowed from Microsoft)
  16. '
  17. '*****************************************************************
  18.  
  19. '-------------------------------------------------------------------------
  20. 'This module is needed because it provides a WinProc used for subclassing.  Tooltips
  21. 'must be provided in this manner because VB5's tooltips for an intrinsic
  22. 'control does not work with the SetCapture API in use.  Also, VB's provided
  23. 'tooltip is container provided.  Therefore, if a control is used in a
  24. 'container that does not provide a tooltiptext property on the extender
  25. 'object, the tooltip would not be provided.  The tooltip in this control is
  26. 'provided regardless of the container hosting it.  The
  27. 'set capture is necessary to know precisely when the mouse moves over the control
  28. 'and then back off the control.
  29. '-------------------------------------------------------------------------
  30.  
  31. Option Explicit
  32.  
  33. Public Type TOOLINFO
  34.     cbSize As Long
  35.     uFlags As Long
  36.     hwnd As Long
  37.     uId As Long
  38.     rct As RECT
  39.     hinst As Long
  40.     lpszText As Long
  41. End Type
  42.  
  43. Public Type MSG
  44.     hwnd As Long
  45.     message As Long
  46.     wParam As Long
  47.     lParam As Long
  48.     Time As Long
  49.     pt As POINTAPI
  50. End Type
  51.  
  52. Public Type NMHDR
  53.     hwndFrom As Long
  54.     idfrom As Long
  55.     code As Long
  56. End Type
  57.  
  58. Public Type ToolTipText
  59.     hdr As NMHDR
  60.     lpszText As Long
  61.     szText As String * 80
  62.     hinst As Long
  63.     uFlags As Long
  64. End Type
  65.  
  66. 'Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
  67. 'Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  68. 'Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  69. 'Public Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  70. 'Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  71. 'Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  72. 'Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  73. 'Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  74. 'Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  75. 'Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  76. 'Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  77. Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
  78. 'Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  79. 'Public Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
  80. 'Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  81. 'Public Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
  82. 'Public Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
  83. 'Public Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
  84. 'Public Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
  85. 'Public Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
  86. 'Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  87. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
  88. 'Public Declare Function CreateHalftonePalette Lib "gdi32" (ByVal hdc As Long) As Long
  89.  
  90. #If UNICODE Then
  91.     Public Declare Function DrawState Lib "user32" Alias "DrawStateW" (ByVal hDC As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
  92.     Public Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, ByVal uMgs As Long, ByVal wParam As Long, lParam As Any) As Long
  93.     Public Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  94.     Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  95.     Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Any) As Long
  96.     Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundW" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
  97.     Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  98. #Else
  99.     Public Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hDC As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
  100.     Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal uMgs As Long, ByVal wParam As Long, lParam As Any) As Long
  101.     Public Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  102.     Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  103.     Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Any) As Long
  104.     Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
  105.     Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  106. #End If
  107. Public Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
  108. Public Declare Sub InitCommonControls Lib "Comctl32.dll" ()
  109. Public Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
  110. Public Declare Function ReleaseCapture Lib "user32" () As Long
  111. Public Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
  112.  
  113. 'Misc Constants
  114. Public Const H_MAX As Long = &HFFFFFFFF + 1
  115. Public Const TOOLTIPS_CLASS As String = "tooltips_class32"
  116. Public Const WS_EX_TOPMOST = &H8&
  117. Public Const CW_USEDEFAULT  As Long = &H80000000
  118. Public Const glSUNKEN_OFFSET = 1
  119. Public Const GDI_ERROR = &HFFFFFFFF
  120.  
  121. 'Windows Messages
  122. Public Const WM_CANCELMODE = &H1F
  123.  
  124. 'Resource String Indexes
  125. Public Const giINVALID_PIC_TYPE As Integer = 10
  126.  
  127. 'Get Windows Long Constants
  128. Public Const GWL_USERDATA = (-21)
  129. Public Const GWL_WNDPROC = (-4)
  130.  
  131. ''Draw State constants
  132. ''Image type
  133. 'Public Const DST_ICON = &H3&
  134. 'Public Const DST_BITMAP = &H4&
  135. ''State type
  136. 'Public Const DSS_DISABLED = &H20&
  137.  
  138. ''Raster Operation Codes
  139. 'Public Const PSDPxax = &HB8074A
  140. 'Public Const DSna = &H220326 '0x00220326
  141.  
  142. 'System colors
  143. Public Const COLOR_BTNFACE = 15
  144. Public Const COLOR_BTNSHADOW = 16
  145. Public Const COLOR_BTNHIGHLIGHT = 20
  146.  
  147. 'Messages to relay to ToolTip
  148. Public Const WM_USER = &H400
  149. Public Const WM_NOTIFY = &H4E
  150. Public Const WM_MOUSEMOVE = &H200
  151. Public Const WM_LBUTTONDOWN = &H201
  152. Public Const WM_LBUTTONUP = &H202
  153. Public Const WM_RBUTTONDOWN = &H204
  154. Public Const WM_RBUTTONUP = &H205
  155. Public Const WM_MBUTTONDOWN = &H207
  156. Public Const WM_MBUTTONUP = &H208
  157.  
  158. 'constants for trapping the tab key
  159. Public Const WM_GETDLGCODE = &H87
  160. Public Const WM_CHAR = &H102
  161. Public Const DLGC_WANTTAB = &H2
  162.  
  163. 'ToolTip style
  164. Public Const TTF_IDISHWND = &H1
  165.  
  166. 'Tool Tip messages
  167. Public Const TTM_ACTIVATE = (WM_USER + 1)
  168. #If UNICODE Then
  169.     Public Const TTM_ADDTOOLW = (WM_USER + 50)
  170.     Public Const TTM_ADDTOOL = TTM_ADDTOOLW
  171. #Else
  172.     Public Const TTM_ADDTOOLA = (WM_USER + 4)
  173.     Public Const TTM_ADDTOOL = TTM_ADDTOOLA
  174. #End If
  175. Public Const TTM_RELAYEVENT = (WM_USER + 7)
  176.  
  177. 'ToolTip Notification
  178. Public Const TTN_FIRST = (H_MAX - 520&)
  179. #If UNICODE Then
  180.     Public Const TTN_NEEDTEXTW = (TTN_FIRST - 10&)
  181.     Public Const TTN_NEEDTEXT = TTN_NEEDTEXTW
  182. #Else
  183.     Public Const TTN_NEEDTEXTA = (TTN_FIRST - 0&)
  184.     Public Const TTN_NEEDTEXT = TTN_NEEDTEXTA
  185. #End If
  186.  
  187. 'Misc ToolTip
  188. Public Const LPSTR_TEXTCALLBACK As Long = -1
  189.  
  190. ' Border flags
  191. 'Public Const BF_LEFT As Long = &H1
  192. 'Public Const BF_TOP As Long = &H2
  193. 'Public Const BF_RIGHT As Long = &H4
  194. 'Public Const BF_BOTTOM As Long = &H8
  195. 'Public Const BF_RECT As Long = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
  196.  
  197. Public Const BF_SOFT As Long = &H1000      ' For softer buttons
  198.  
  199. Public Const SND_SYNC = 0
  200. Public Const EVENT_MENU_COMMAND = "MenuCommand"
  201. Public Const EVENT_MENU_POPUP = "MenuPopup"
  202.  
  203.  
  204. ''Button States
  205. 'Public Const giFLATTENED As Integer = 0
  206. 'Public Const giRAISED As Integer = 1
  207. 'Public Const giSUNKEN As Integer = 3
  208. 'Public Const giDISABLED As Integer = 4
  209.  
  210. 'VB Errors
  211. Public Const giOBJECT_VARIABLE_NOT_SET As Integer = 91
  212. Public Const giDLL_FUNCTION_NOT_FOUND As Integer = 453
  213.  
  214. 'Windows Errors
  215. Public Const ERROR_CALL_NOT_IMPLEMENTED As Long = 120
  216.  
  217.  
  218. Public gHWndToolTip As Long                 'Hwnd of Tooltip created by this object
  219. Public gbToolTipsInstanciated As Boolean    'If true the ToolTip class window has been created
  220. Public glToolsCount As Long                 'The number of controls using tool tips
  221.                                             
  222. #If DEBUGSUBCLASS Then
  223.     Public goWindowProcHookCreator As Object
  224. #End If
  225.  
  226. Public Function SubWndProc(ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  227.     '-------------------------------------------------------------------------
  228.     'Purpose:   Address used for subclassing.  Calls instance of uctlSoftButton
  229.     '           whose hWnd is stored in USERDATA of window matching passed hWnd
  230.     '-------------------------------------------------------------------------
  231.     On Error Resume Next
  232.     SubWndProc = ConvertUserDataToPopupCommand(hwnd).WindowProc(hwnd, MSG, wParam, lParam)
  233. End Function
  234.  
  235. Private Function ConvertUserDataToPopupCommand(hwnd As Long) As axGridButton
  236.     '-------------------------------------------------------------------------
  237.     'Purpose:   Gets the hWnd of a uctlPopupCommand object, and converts it
  238.     '           to a reference to the uctlPopupCommand object without increasing
  239.     '           VB's ref count of that object
  240.     '-------------------------------------------------------------------------
  241.     Dim obj As axGridButton
  242.     Dim pObj As Long
  243.     pObj = GetWindowLong(hwnd, GWL_USERDATA)
  244.     CopyMemory obj, pObj, 4
  245.     Set ConvertUserDataToPopupCommand = obj
  246.     CopyMemory obj, 0&, 4
  247. End Function
  248.  
  249. Public Function GetUltimateParent(obj As Object) As Form
  250.     Dim tobj As Object
  251.     Dim tobj2 As Object
  252.     Dim bFound As Boolean
  253.     
  254.     'returns the last UserControl in a chain
  255.     
  256.     bFound = False
  257.     Set tobj2 = obj
  258.     Do
  259.         Set tobj = tobj2
  260.         If tobj Is Nothing Then
  261.             Set tobj2 = Nothing
  262.         Else
  263.             Set tobj2 = tobj.Container
  264.         End If
  265.         If tobj2 Is Nothing Then
  266.             Set tobj = Nothing
  267.             bFound = True
  268.         Else
  269.             bFound = TypeOf tobj2 Is Form
  270.         End If
  271.     Loop While Not bFound
  272.     Set GetUltimateParent = tobj
  273. End Function
  274.